Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/ViewIt 2.24/FORTRAN Demo Projects/Absoft MacFortran II 3.2 Demos/Old MF 020 Stuff/vDemoMF.for

Text File | 1994-03-12 | 4.6 KB | 147 lines | [TEXT/EDIT]

C ViewIt 2.2 Demonstration Program
C ©FaceWare 1991-94.  All Rights Reserved.

      PROGRAM vDemoMF
    implicit none
    INTEGER*4 PTR
    PARAMETER (PTR = Z'C0000000')
    INTEGER DELAY
    PARAMETER (DELAY=Z'03B80020')
    INTEGER TICKCOUNT
    PARAMETER (TICKCOUNT=Z'97580000')
    INTEGER SETCTLVALUE
    PARAMETER (SETCTLVALUE=Z'96311000')

    logical*4 helpShown
    integer*2 myInteger,myList
    integer*4 myFlags,myPtr,toolbx,oldTicks,newTicks
    real*4 myReal,theReal,delta
    character*100 myString
    integer*1 myRec(110)
    equivalence (myRec(1),myInteger)
    equivalence (myRec(3),myReal)
    equivalence (myRec(7),myString)
    equivalence (myRec(107),myFlags)

      include FaceStorMF.inc

C For MF, "ctlprc" is necessary to support the "override" example.
C ctlprc returns an address that can be passed to the OvrCtl command.
C ctlprc is passed the name of the override routine and the number
C of bytes (4) that will be passed by ViewIt when calling the routine.
    integer*4 OverPtr,OverProc,ctlprc
    external OverProc
    OverPtr = ctlprc(OverProc,4)  !ctlprc locks itself into memory

    load JumpIt     !!!REMOVE this line if JumpIt is linked to program!!!
    load toolbx  !!!REMOVE this line if toolbx is linked to program!!!

    myInteger = 0
    myReal = 6.2
    myString = 'Hello'
    myFlags = 10
    myList = 2
    oldTicks = 0
    theReal = 6.0

C Initialize FaceIt
      uName = 'vDemo.Rsrc'
      call FaceIt(0,DoInit,0,0,0,0)

C Open Modeless Window using FWND 1000
    call FaceIt(0,NewWnd,1000,1,0,0)

      do
        call FaceIt(0,DoLoop,0,0,0,0)
C Standard "About" Menu Item Selection
      if ((uMenuID = 101).and.(uMenuItem = 1)) then
        uString = 'Demonstration of the use of ViewIt'
     +//char(13)//'windows in a FaceIt-based program.'
        call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
C Hit in Modeless Window's "Open Modal" Button
      else if ((uMenuID = 1000).and.(wcHit = 2)) then
        call FaceIt(0,NewWnd,1001,0,0,0)  !Open Modal Window
        do
          call FaceIt(0,MdlWnd,1001,0,0,0)  !Process Modal Events
        if (wcHit = -1) then            !Hit in Close Box
          exit
        else if (wcHit = 1) then        !Hit in "Open Nested"
          myPtr = toolbx(PTR,myRec)
          call FaceIt(0,NewWnd,1002,0,110,myPtr)!Open Nested Modal
          call FaceIt(0,GetCtl,1002,0,3,3)      !Link Scrollable List
          myPtr = toolbx(PTR,myList)
          call FaceIt(0,LnkCtl,cControl,myPtr,2,0)
          call FaceIt(0,GetCtl,1002,0,2,3)      !Set Override Proc
          call FaceIt(0,OvrCtl,cControl,OverPtr,0,0)
          call FaceIt(0,SetVal,1002,0,0,0)      !Set Linked Values
          helpShown = .false.
          do
            call FaceIt(0,MdlWnd,1002,-2,0,0) !Process Modal Events
            if (uMenuID = 0) then          !No Message
              newTicks = toolbx(TICKCOUNT)
            if (newTicks > oldTicks + 60) then
              oldTicks = newTicks
              call FaceIt(0,GetCtl,1002,0,2,8)
              call toolbx(SETCTLVALUE,cControl,
     +            mod(int(cValue),4) + 1)
            end if
            else if (wvHit = 1) then          !Hit in View #1
              if (wcHit = 1) then          !Hit in "OK" Button
              exit
            else if (wcHit = 2) then      !Hit in "Show/Hide"
              if (helpShown) then
                call FaceIt(0,ShoCtl,0,0,-3,2)    !Hide v3, Show v2
                helpShown = .false.
              else
                call FaceIt(0,ShoCtl,0,0,-2,3)    !Hide v2, Show v3
                helpShown = .true.
              end if
            end if
            else if (wvHit = 2) then          !Hit in View #2
              if ((wcHit = 6).or.(wcHit = 7)) then
              call FaceIt(0,GetCtl,1002,0,2,int(wcHit))
              delta = 0.001 * (cMin - 2)
              myReal = myReal + delta
              call FaceIt(0,SetVal,1002,0,2,2)
              call toolbx(DELAY,5,uI4)
            end if
            end if
          repeat
          call FaceIt(0,GetVal,1002,0,0,0)      !Get Linked Values
          call FaceIt(0,EndWnd,1002,0,0,0)      !Close Nested Modal
        end if
        repeat
        call FaceIt(0,EndWnd,1001,0,0,0)  !Close Modal Window
C Hit in Modeless Window's "Why ViewIt?" Button
      else if ((uMenuID = 1000).and.(wcHit = 3)) then
        myPtr = toolbx(PTR,theReal)
        call FaceIt(0,NewWnd,1003,0,0,myPtr)
        call FaceIt(0,SetVal,1003,0,0,0)
        do
          call FaceIt(0,MdlWnd,1003,0,0,0)
        if (wcHit = 1) exit
        repeat
        call FaceIt(0,GetVal,1003,0,0,0)
        call FaceIt(0,EndWnd,1003,0,0,0)
      end if
    repeat
      end

C The "OverPtr" passed to OvrCtl results in this routine being called
C with a single 4-byte parameter that contains the address of the value
C passed by ViewIt. The "long" function is then used to get "thePtr".
    SUBROUTINE OverProc(argptr)
    implicit none
    integer*4 argptr,thePtr
      include FaceStorMF.inc
    thePtr = long(argptr)
    if (uCommand = 264) then    !a key down message?
      if (uParam(1) = 32) then    !SPACE key pressed?
        uParam(1) = 95        !convert to UNDERLINE
      end if
    end if
    call JumpIt(thePtr)        !pass message to driver
    end

      include FaceProcMF.inc